/* REXX _finder.zrx by the reverend (build 220)                               */
/*-       built by rev-builder version 1.1 on 02 Jan 2003 at 11:11:22        -*/
/*- ------------------------------------------------------------------------ -*/
/*-                       Copyright (C) 2001 Ron Wilson                      -*/
/*-                                                                          -*/
/*- This script is free, and can be modified for your personal use, but you  -*/
/*- cannot copy or distribute this script or any derivative work based upon  -*/
/*- this script without the express permission of the author. Your use of    -*/
/*- this script is governed by the terms of the REV-LICENSE.                 -*/
/*-                                                                          -*/
/*- This program is provided to you WITHOUT ANY WARRANTY, even the implied   -*/
/*- warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -*/
/*- REV-LICENSE for more details.                                            -*/
/*-                                                                          -*/
/*-                A copy of the REV-LICENSE is available at:                -*/
/*-       http://thereverend.coastgames.com/tradewars/rev-license.html       -*/
/*- ------------------------------------------------------------------------ -*/
/* description:  find just about anything in the universe with this script.   */
/*               the former _findfigs and _findports scripts are obsolete     */
/*               with this script.  one script does it all and more.          */
/* rev. 0 - initial release                                                   */

call zoctimeout 60
call zocsynctime 500
globals=_setglobals()
call on halt name _halt

cp=_pcheck("Command [")
ol=_isonline(1)

call _newline _ansi("bt;fgr")
parse value _getgameinfo() with spath ";" iname ";" game
parse value _getloginfo() with lpath ";" ldefault
sd=_ini_askint("stardock?", 0, iname, game, "sd")
ns=_ini_askint("ns?", 0, iname, game, "ns")
bust_clear=_ini_askint("bust clear freq?", 1, iname, game, "bust_clear")
g.!timediff=_ini_askint("##DEFAULT##", 0, iname, game, "timediff")
extern=_ini_asknum("extern?", 0, iname, game, "extern")
cname=_ini_askstr("cim?", "cim", iname, game, "cim")
call zoctimeout ns%10

fname=lpath||cname||"_figs.txt"
vname=lpath||cname||"_voids.txt"
bname=lpath||cname||"_bust.txt"
mname=lpath||cname||".map"
if \_fileexists(mname) then call _error "file not found: "||mname
reclen=_mapinit(mname)

mode="file"
if ol then if _yesno("refresh offline fig/void data?") then mode=""
if \cp & mode="" then call _error "please start at the command prompt."

call _getvoids vname, mode
call _getfigs fname, mode
now=_getservertime("stamp")
call _getbusts bname, now-bust_clear*86400

call zocwriteln _ansi("bt;fwh")
searchstring="f:1"
max=255

if ol then home=_getinfo("sect")
      else home=1
do FOREVER
 home=_askint("start search from sector:",home,"c")
 searchstring=_mapgetsearchstring("select criteria:",searchstring)
 find=_mapfind(home,searchstring,mname,reclen,max)
 call zocwrite " "||_pad(find,5,"R")
 if _p.find\="" ,
  then call zocwrite " "||_dword(_p.find,1,";")
  else call zocwrite "    "
 if pos("r:1",searchstring)>0 ,
  then call zocwriteln " - ("||_dist.find.home||" hops)" translate(_path.find.home,">",";")
  else call zocwriteln " - ("||_dist.home.find||" hops)" translate(_path.home.find,">",";")
end /*do*/

exit


/***                 THE REVEREND'S TW LIBRARY FOR ZOC/REXX                 ***/

/** _setglobals v.3 **/
    _setglobals: procedure expose _verbose _monthdays _monthnames _baseday. (globals)
    
     _verbose=0
     _monthdays="31;28;31;30;31;30;31;31;30;31;30;31"
     _monthnames="jan;feb;mar;apr;may;jun;jul;aug;sep;oct;nov;dec"
     _baseday.2000=730118
     _baseday.2001=_baseday.2000+365+1
     _baseday.2002=_baseday.2001+365
     _baseday.2003=_baseday.2002+365
     _baseday.2004=_baseday.2003+365
     _baseday.2005=_baseday.2004+365+1
     _baseday.2006=_baseday.2005+365
     _baseday.2007=_baseday.2006+365
     _baseday.2008=_baseday.2007+365
    
     rslt="_g. _s. _p. _d. _v. _f. _m. _q. "
     rslt=rslt||"_ef. _es. _et. _ep. "
     rslt=rslt||"_path. _dist. _dtomsl. _dfrmsl. "
     rslt=rslt||"_bg. _nwi. _od. _sv. _pv. _bust. _vs. _vn. "
     rslt=rslt||"_olist1. _olist2. _clvlist1. _clvlist2. "
     rslt=rslt||"_verbose _monthdays _monthnames _baseday. "
     rslt=rslt||"globals reconnect scriptname lra "
     if arg(1,"E") then rslt=rslt||arg(1)
    
     rslt=_space(rslt)
    return rslt

/** _halt v.3 **/
    _halt: procedure expose (globals)
     call off halt
     call zocwriteln "^[[1;33m< user abort >^[[0m "
     exit
    return

/** _pcheck v.4 **/
    _pcheck: procedure expose (globals)
     pc1=arg(1)
     pc2=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     rslt=0
     do i=1 to _dwords(pc1,";")
      if _instr(_dword(pc1,i,";"),pc2,"cs") then rslt=1
     end /*do*/
    return rslt

/** _isonline v.3 **/
    _isonline: procedure expose (globals)
     if zocgetinfo("ONLINE")="##YES##" then return 1
     if arg(1,"E") then t=arg(1)
     else call _error "missing parameter in _isonline"
     rslt=0
     o="##NO##"
     call time "R"
     do while time("E")<=t & o\="##YES##"
      o=zocgetinfo("ONLINE")
      if o="##YES##" then rslt=1
     end /*do*/
    return rslt

/** _newline v.2 **/
    _newline: procedure expose (globals)
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln arg(1)
     else call zocwrite arg(1)
    return

/** _ansi v.3 **/
    _ansi: procedure expose (globals)
     rslt="0"
     do i=1 to _dwords(arg(1),";")
      w=_dword(arg(1),i,";")
      select
       when w="dl"  then rslt=rslt||";"||0  /* dull               */
       when w="bt"  then rslt=rslt||";"||1  /* bright             */
       when w="ul"  then rslt=rslt||";"||4  /* underlined         */
       when w="blk" then rslt=rslt||";"||5  /* blinking           */
       when w="fbk" then rslt=rslt||";"||30 /* black foreground   */
       when w="frd" then rslt=rslt||";"||31 /* red foreground     */
       when w="fgr" then rslt=rslt||";"||32 /* green foreground   */
       when w="fye" then rslt=rslt||";"||33 /* yellow foreground  */
       when w="fbl" then rslt=rslt||";"||34 /* blue foreground    */
       when w="fmg" then rslt=rslt||";"||35 /* magenta foreground */
       when w="fcy" then rslt=rslt||";"||36 /* cyan foreground    */
       when w="fwh" then rslt=rslt||";"||37 /* white foreground   */
       when w="bbk" then rslt=rslt||";"||40 /* black background   */
       when w="brd" then rslt=rslt||";"||41 /* red background     */
       when w="bgr" then rslt=rslt||";"||42 /* green background   */
       when w="bye" then rslt=rslt||";"||43 /* yellow background  */
       when w="bbl" then rslt=rslt||";"||44 /* blue background    */
       when w="bmg" then rslt=rslt||";"||45 /* magenta background */
       when w="bcy" then rslt=rslt||";"||46 /* cyan background    */
       when w="bwh" then rslt=rslt||";"||47 /* white background   */
       otherwise nop
      end /*select*/
     end /*do*/
     rslt="^[["||rslt||"m"
    return rslt

/** _getgameinfo v.5 **/
    _getgameinfo: procedure expose (globals)
     spath=_getscriptpath()
     base=spath||"script.ini"
    
     if arg(1,"E") then fname=arg(1)
     else fname=base
    
     parse value zocgetglobaloption("WindowTitle") with . '="' game '"'
     if fname\=base | game="" | game="%ZOCORHOST% %OPTIONS%" then do
      list=_ini_getheadings(fname)
      if list="##EOF##" then game="##EOF##"
      else do
       templist=""
       do i=1 to _dwords(list,";")
        temp=_dword(list,i,";")
        if left(temp,1)\="*" then do
         if templist="" then templist=temp
         else templist=templist||";"||temp
        end /*if*/
       end /*do*/
       list=templist
       game=_drequestlist("select a game:", list, ";", "c")
      end /*else*/
     end /*do*/
    
     call zocwrite _ansi("bt;fgr")||"< using "
     if length(fname)>17 then call zocwrite "..."
     call zocwriteln right(fname,min(length(fname),17))||" - ["||game||"] >"
    
     rslt=spath||";"||fname||";"||game
    return rslt

/** _getloginfo v.2 **/
    _getloginfo: procedure expose (globals)
     parse value zocgetoption("CaptDefaultName") with . '="' ldefault '"'
     parse value zocgetglobaloption("CapturePath") with . '="' lpath '"'
     lpath=dosfname(lpath)
     if right(lpath,1)\="\" then lpath=lpath||"\"
     if \dosisdir(lpath) then call _error "invalid path in _getloginfo"
     rslt=lpath||";"||ldefault
    return rslt

/** _ini_askint v.5 **/
    _ini_askint: procedure expose (globals)
     if \arg(1,"E") then msg="enter an integer"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askint"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripint(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripint(default)
      when rslt="##EOF##"                     then rslt=_askint(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripint(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripint(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _ini_asknum v.5 **/
    _ini_asknum: procedure expose (globals)
     if \arg(1,"E") then msg="enter a number"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_asknum"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if _stripnum(default)\=default then call _error "invalid parameter in _ini_askint"
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=_stripnum(default)
      when rslt="##EOF##"                     then rslt=_asknum(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then rslt=_stripnum(rslt)
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwriteln right(fname,min(length(fname),17))||" - "||key||"="||rslt||" >"
       rslt=_stripnum(rslt)
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _ini_askstr v.5 **/
    _ini_askstr: procedure expose (globals)
     if \arg(1,"E") then msg="enter a number"
     else msg=arg(1)
     do i=2 to 5
      if \arg(i,"E") then call _error "missing parameter in _ini_askstr"
     end /*do*/
     default=arg(2)
     fname=arg(3)
     section=arg(4)
     key=arg(5)
     mode=lower(arg(6))
     if section="##EOF##" then rslt="##EOF##"
     else rslt=_ini_read(fname, section, key)
     select
      when rslt="##EOF##" & msg="##DEFAULT##" then rslt=default
      when rslt="##EOF##"                     then rslt=_askstr(msg||" ("||key||"=)",default,"c")
      when mode="quiet"                       then nop
      when mode=""                            then do
       call zocwrite _ansi("bt;fgr")||"< using "
       if length(fname)>17 then call zocwrite "..."
       call zocwrite right(fname,min(length(fname),17))||" - "
       call zocwrite key||"="||left(translate(rslt,"~","^"),min(length(rslt),25))
       if length(rslt)>25 then call zocwrite "..."
       call zocwriteln " >"
      end /*when*/
      otherwise nop
     end /*select*/
    return rslt

/** _fileexists v.3 **/
    _fileexists: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileexists"
     if stream(arg(1), "C", "QUERY EXISTS")="" then rslt=0; else rslt=1
    return rslt

/** _error v.7 **/
    _error: procedure expose (globals)
     call off halt
     if zocgetinfo("CURSOR-X")>0 then call zocwriteln
     call zocwrite _ansi("bt;frd")||"< script error"
     if arg(1,"E") then call zocwrite ": "||arg(1)
     call zocwriteln " >"
     call zocwriteln _ansi("bt;fye")||"< if this is a serious problem, email me at: the.reverend@coastgames.com > "
     call zocwriteln "< ZOC VERSION '"||zocgetinfo("VERSION")||"', OS '"||zocgetinfo("OSYS")||"', LOCATION '"||zocgetinfo("CONNECTEDTO")||"' >"
     if arg(2,"E") then call zocwriteln _ansi("bt;fgr")||"< "||arg(2)||" >"
     call zocwrite _ansi()
     call _beep "error.wav"
     if reconnect=1 & arg(1)="timeout" then do
      /* call zocdisconnect */
      call zocwriteln _ansi("bt;fwh")||"< ATTEMPTING TO RECONNECT >"
      call zocdostring "^RUN=_connect.zrx sn="||scriptname
     end /*if*/
    exit

/** _mapinit v.3 **/
    _mapinit: procedure expose (globals)
     if _f.0="_F.0" then _f.=0
     if _s.0="_S.0" then _s.=""
     if _p.0="_P.0" then _p.=""
     if _dist.0.0="_DIST.0.0" then _dist.=255
     if _path.0.0="_PATH.0.0" then _path.=""
     if _dtomsl.0="_DTOMSL.0" then _dtomsl.=255
     if _dfrmsl.0="_DFRMSL.0" then _dfrmsl.=255
     if _bg.0="_BG.0" then _bg.=0
     if _nwi.0="_NWI.0" then _nwi.=0
     if _od.0="_OD.0" then _od.=0
     if _sv.0="_SV.0" then _sv.=0
     if _pv.0="_PV.0" then _pv.=0
     if _bust.0="_BUST.0" then _bust.=0
     if _v.0="_V.0" then _v.=0
     if _vs.0="_VS.0" then _vs.=0
     if _vn.0="_VN.0" then _vn.="(na)"
     fname=arg(1)
     if \_fileopenr(fname) then call _error "unable to open map file: "||fname
     reclen=c2d(charin(fname))
    return reclen

/** _yesno v.3 **/
    _yesno: procedure expose (globals)
     if arg(1,"E") then msg=arg(1)
     else msg="yes or no"
     if arg(2)="yn" then rslt=zocrequest(msg||" (ESC=no)", "yes", "no")
                    else rslt=zocrequest(msg, "yes", "no", "cancel")
     select
      when rslt="cancel" then call _quit "script cancelled by user.", "nocopy"
      when rslt="##CANCEL##" & arg(2)\="yn" then call _quit "script cancelled by user.", "nocopy"
      when rslt="yes" then rslt=1
      otherwise rslt=0
     end /*select*/
    return rslt

/** _getvoids v.7 **/
    _getvoids: procedure expose (globals)
     fname=arg(1)
     mode=arg(2)
     _v.=0
     c=0
     if lower(mode)="file" then do
      if _fileopenr(fname) then do
       call zocwrite _ansi("bt;fye")
       mon=0
       do while \_fileeof(fname)
        n=linein(fname)
        if _stripint(n)\="" then do
         _v.n=1
         c=c+1
         mon=_spinner(mon,10)
        end /*if*/
       end /*do*/
       call _fileclose(fname)
       call zocwrite " ("||c||") "||_ansi("dl;fmg")
      end /*if*/
     end /*if*/
     else do
      buflen=16*1024
      call zocreceivebuf buflen
      if _sendwait("cx","<List Avoided Sectors>")=640 then call _error "timeout"
      if zocwait("Computer command")=640 then call _error "timeout"
      call zocsend "q"
      if zocwaitmux("Command [", "Citadel command")=640 then call _error "timeout"
      buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
      if length(buff)=buflen then call _error "buffer overflow"
      call zocwrite _ansi("bt;fye")
    
      s=0
      i=0
      j=0
      i=pos("<List Avoided Sectors>",buff)
      i=pos(d2c(13),buff,i)+1
      i=pos(d2c(13),buff,i)+1
      j=pos(d2c(13),buff,i)
      mon=0
      do while j>0
       line=_space(substr(buff,i,j-i),1)
       if line="" then leave
       if line="No Sectors are currently being avoided." then leave
       do k=1 to words(line)
        s1=_stripint(word(line,k))
        if s1\="" then do
         _v.s1=1
         c=c+1
         s=max(s,s1)
        end /*if*/
       end /*do*/
       i=j+1
       j=pos(d2c(13),buff,i)
       mon=_spinner(mon,10)
      end /*do*/
      call zocwrite " ("||c||") "||_ansi("dl;fmg")
      if fname\="" then do
       if _fileexists(fname) then call dosdel fname
       if _filenew(fname) then do
        call zocwrite _ansi("bt;fye")
        mon=0
        do i=1 to s
         if _v.i then do
          call lineout fname, i
          mon=_spinner(mon,10)
         end /*if*/
        end /*do*/
        call _fileclose(fname)
        call zocwriteln " "||_ansi("dl;fmg")
       end /*if*/
      end /*if*/
     end /*else*/
    
    return c

/** _getfigs v.13 **/
    _getfigs: procedure expose (globals)
     fname=arg(1)
     mode=arg(2)
     _f.=0
     c=0
     if lower(mode)="file" then do
      if _fileopenr(fname) then do
       call zocwrite _ansi("bt;fye")
       mon=0
       do while \_fileeof(fname)
        n=linein(fname)
        if _stripint(n)\="" then do
         _f.n=1
         c=c+1
         mon=_spinner(mon,100)
        end /*if*/
       end /*do*/
       call _fileclose(fname)
       call zocwrite " ("||c||") "||_ansi("dl;fmg")
      end /*if*/
     end /*if*/
     else do
      buflen=1024*1024
      call zocreceivebuf buflen
      call zocsend "g"
      if zocwait("Deployed  Fighter  Scan")=640 then call _error "timeout"
      ans=0
      do while ans=0
       ans=zocwaitmux("r","Total","deployed")
      end /*do*/
      if ans=640 then call _error "timeout"
      buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
      if length(buff)=buflen then call _error "buffer overflow"
      call zocwrite _ansi("bt;fye")
    
      s=0
      i=0
      j=0
      i=pos(d2c(13),buff,pos("==",buff)+1)+1
      if i>1 then j=pos(d2c(13),buff,i)
      finish=pos("Total",buff,i)
      mon=0
      do while j>0 & j<finish
       line=strip(substr(buff,i,j-i))
       parse var line s1 . type .
       s1=_stripint(s1)
       if (type="Corp" | type="Personal") & s1\="" then do
        _f.s1=1
        c=c+1
        s=max(s,s1)
       end /*if*/
       i=j+1
       j=pos(d2c(13),buff,i)
       mon=_spinner(mon,100)
      end /*do*/
      call zocwrite " ("||c||") "||_ansi("dl;fmg")
      if fname\="" then do
       if _fileexists(fname) then call dosdel fname
       if _filenew(fname) then do
        call zocwrite _ansi("bt;fye")
        mon=0
        do i=1 to s
         if _f.i>0 then do
          call lineout fname, i
          mon=_spinner(mon,100)
         end /*if*/
        end /*do*/
        call _fileclose(fname)
        call zocwriteln " "||_ansi("dl;fmg")
       end /*if*/
      end /*if*/
     end /*else*/
    
    return c

/** _getservertime v.7 **/
    _getservertime: procedure expose (globals)
    
     /* get real date/time values */
        parse value date("N") with . . year
        parse value date("O") with . "/" month "/" day
        sod=time("S")
        doy=date("D")
        base=date("B")
        parse value time("N") with hr ":" mn ":" sc
        leapyear=abs((year//4=0)-1)
        base=base-_baseday.2000
        base_sec=base*86400+sod
    
     /* get game date/time values */
        if _g.!timediff="_G.!TIMEDIFF" then do
         if _sendwait("ct","(?=Help)? T")=640 then call _error "timeout"
         if zocwaitmux(", "||year+11, ", "||year+12, ", "||year+13)=640 then call _error "timeout"
         line=_lastline()
         call zocsend "q"
         parse var line g_hr ":" g_min ":" g_sec g_ampm . g_month g_day ", " g_year .
         g_year=g_year-12
         if g_ampm="PM" & g_hr\=12 then g_hr=g_hr+12
         g_month=lower(g_month)
         do i=12 to 1 by -1
          if g_month=_dword(_monthnames,i,";") then leave
         end /*do*/
         g_month=i
         parse value _calc_base_date(g_year, g_month, g_day, g_hr, g_min, g_sec) with g_base ";" g_doy ";" g_sod ";" g_base_sec
         _g.!timediff=base_sec-g_base_sec
        end /*if*/
        else do
         g_base_sec=base_sec-_g.!timediff
         g_sod=g_base_sec//86400
         g_base=g_base_sec%86400
         do i=2000 to 2008
          if (_baseday.i-_baseday.2000)<=g_base then g_year=i
         end /*do*/
         g_doy=g_base-_baseday.g_year+_baseday.2000
        end /*else*/
    
     select
      when arg(1)="seconds"   then rslt=g_sod
      when arg(1)="minutes"   then rslt=g_sod%60
      when arg(1)="hours"     then rslt=g_sod%3600
      when arg(1)="stamp_old" then rslt=g_year-2000||copies("0",3-length(g_doy))||g_doy||copies("0",5-length(g_sod))||g_sod
      when arg(1)="stamp"     then rslt=g_base_sec
      otherwise                    rslt=g_base_sec
     end /*select*/
    return rslt

/** _getbusts v.2 **/
    _getbusts: procedure expose (globals)
     fname=arg(1)
     if arg(2,"E") then safedate=arg(2)
                   else safedate=0
     _bust.=0
     max=0
    
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=linein(fname)
       parse var line cmd . sector . stamp .
       if lower(sector)\="all" & sector\="" then max=max(max,sector)
       select
        when cmd="BUST_CLR" & (lower(sector)="all" | sector=0) then do
         do i=1 to max
          if stamp>abs(_bust.i) & _bust.i\=0 then _bust.i=-stamp
         end /*do*/
        end /*when*/
        when abs(_bust.sector)>stamp then nop
        when cmd="BUST_ADD" & safedate=0     then _bust.sector=stamp
        when cmd="BUST_ADD" & safedate>stamp then _bust.sector=-stamp
        when cmd="BUST_CLR"                  then _bust.sector=-stamp
        otherwise nop
       end /*select*/
      end /*do*/
      call _fileclose fname
     end /*if*/
    
     call _newline _ansi("bt;fwh")
     call zocwriteln "BUST LIST:"
     count=0
     earliest=999999999
     do i=1 to max
      if _bust.i>0 then do
       count=count+1
       call zocwrite _pad(i,6,"R")
       earliest=min(earliest,_bust.i)
       if count//12=0 then call zocwriteln
      end /*if*/
     end /*do*/
     if count//12>0 then call zocwriteln
    
    return earliest

/** _getinfo v.5 **/
    _getinfo: procedure expose (globals)
     args=lower(arg(1))
     bufflen=3*1024
     call zocreceivebuf bufflen
     call zocsend "/"
     if zocwait("Sect ")=640 then call _error "timeout"
     if zocwait("Ship ")=640 then call _error "timeout"
     if zocwait("^M")=640 then call _error "timeout"
     buff=translate(zocreceivebuf(0),"  ",d2c(10)||d2c(0))
     if length(buff)>=bufflen then call zocwrite "<buffer overflow>"
     i=pos("Sect ",buff)
     j=pos("Ship",buff,i)
     j=pos(d2c(13),buff,j)
     buff=substr(buff,i,j-i)
     buff=_space(translate(buff, "  ;;", d2c(0)||d2c(10)||d2c(13)||d2c(179)),1)
     buff=translate(_space(translate(buff,", "," ,"),0),", "," ,")
    
     vr.=""
     vl.=""
     c=0
     do j=1 to _dwords(buff,";")
      c=c+1
      vr.c=strip(_dword(buff,j,";"))
      vl.c=word(vr.c,2)
      vr.c=lower(word(vr.c,1))
      if vr.c="ship" then do
       c=c+1
       vr.c=strip(_dword(buff,j,";"))
       vl.c=word(vr.c,3)
       vr.c="shiptype"
      end /*if*/
     end /*do*/
    
     rslt=""
     do i=1 to _dwords(args,";")
      found=0
      do j=1 to c
       if vr.j=_dword(args,i,";") then do
        rslt=rslt||";"||vl.j
        found=1
       end /*if*/
      end /*do*/
      if \found then rslt=rslt||";"||"##NA##"
     end /*do*/
     if rslt\="" then rslt=substr(rslt,2)
    
    return rslt

/** _askint v.2 **/
    _askint: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an integer:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripint(rslt)\=rslt | rslt=""
      default=rslt||" [please enter an integer or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _mapgetsearchstring v.2 **/
    _mapgetsearchstring: procedure expose (globals)
     msg=arg(1)
     rslt=arg(2)
     yes="> "
     no="   "
     ptype="XXX"
     symbol.="="
     quant.=0
     menustr.1="r;reverse plot;find from A to B,find from B to A"
     menustr.2="f;figs;no criteria,without figs,with figs"
     menustr.3="v;voids;no criteria,unvoided sectors,voided sectors"
     menustr.4="e;explored;no criteria,unexplored sectors,explored sectors"
     menustr.5="pv;port visible;no criteria,port blocked,port visible"
     menustr.6="pb;port busted;no criteria,port clear,port busted"
     menustr.7="d;deadend;no criteria,not a deadend sector,deadend sector"
     menustr.8="b;bubble;no criteria,not in a bubble,in a bubble"
     menustr.9="pt;port type;no criteria,no port,any port,specific port="||ptype
     menustr.10="p1;fuel ore;no criteria,quantity"||symbol.10||quant.10
     menustr.11="p2;organics;no criteria,quantity"||symbol.11||quant.11
     menustr.12="p3;equipment;no criteria,quantity"||symbol.12||quant.12
     menustr.13="tm;dist to msl;no criteria,distance"||symbol.13||quant.13
     menustr.14="fm;dist from msl;no criteria,distance"||symbol.14||quant.14
     menustr.0=14
    
     menuval.1=1
     do i=2 to menustr.0
      menuval.i=1
     end /*do*/
     menuval.0=menustr.0
    
     ans=99
     do while ans>0
      menu="DONE"
      do i=1 to menustr.0
       menutag=_dword(menustr.i,1,";")
       do j=1 to _dwords(rslt,";")
        tag=_dword(rslt,j,";")
        tag1=_dword(tag,1,":")
        tag2=_dword(tag,2,":")
        if tag1=menutag then do
         select
          when i=1 then menuval.i=tag2+1
          when i<=8 then menuval.i=tag2+2
          when i=9 & _portmatch("xxx",tag2) then do
           menuval.i=4
           ptype=tag2
           menustr.i="pt;port type;no criteria,no port,any port,specific port="||ptype
          end /*when*/
          when i=9 then menuval.i=tag2+2
          when i<=14 & tag2\=-1 then do
           menuval.i=2
           quant.i=_stripint(tag2)
           symbol.i=strip(translate(tag2," ",quant.i))
          end /*when*/
          when i<=14 then menuval.i=tag2+2
          otherwise nop
         end /*select*/
        end /*if*/
       end /*do*/
       select
        when i=10 then menustr.10="p1;fuel ore;no criteria,quantity"||symbol.10||quant.10
        when i=11 then menustr.11="p2;organics;no criteria,quantity"||symbol.11||quant.11
        when i=12 then menustr.12="p3;equipment;no criteria,quantity"||symbol.12||quant.12
        when i=13 then menustr.13="tm;dist to msl;no criteria,distance"||symbol.13||quant.13
        when i=14 then menustr.14="fm;dist from msl;no criteria,distance"||symbol.14||quant.14
        otherwise nop
       end /*select*/
       menutxt=_dword(menustr.i,2,";")
       menulst=_dword(menustr.i,3,";")
       menuitem=menutxt||" - "||_dword(menulst,menuval.i,",")
       if menuval.i=1 then s=no
       else s=yes
       menu=menu||";"||s||menuitem
      end /*do*/
     
    
      ans=_drequestlisti(msg,menu,";")-1
    
      select
       when ans=-1 then call _quit "script cancelled by user."
       when ans=0 then nop
       when ans=1 then menuval.ans=abs(menuval.ans-2)+1
       when ans<=8 then do
        submenu=_dword(menustr.ans,3,";")
        menuval.ans=_drequestlisti("pick an option",submenu,",")
       end /*when*/
       when ans=9 then do
        submenu=_dword(menustr.ans,3,";")
        menuval.ans=_drequestlisti("pick an option",submenu,",")
        if menuval.ans=4 then do
         ptype=_askporttype(, ptype, "c")
         menustr.ans="pt;port type;no criteria,no port,any port,specific port="||ptype
        end /*if*/
       end /*when*/
       when ans<=14 then do
        submenu=_dword(menustr.ans,3,";")
        menuval.ans=_drequestlisti("pick an option",submenu,",")
        if menuval.ans=2 then do
         select
          when ans=10 then msg1="how much fuel ore?"
          when ans=11 then msg1="how much organics?"
          when ans=12 then msg1="how much equipment?"
          when ans>=13 then msg1="how many hops?"
          otherwise nop
         end /*select*/
         symbol.ans=_chooselist("choose:","<;>=;=;<>",";","c")
         quant.ans=_askint(msg1, menuval.ans, "c")
         select
          when ans=10 then menustr.ans="p1;fuel ore;no criteria,quantity"||symbol.ans||quant.ans
          when ans=11 then menustr.ans="p2;organics;no criteria,quantity"||symbol.ans||quant.ans
          when ans=12 then menustr.ans="p3;equipment;no criteria,quantity"||symbol.ans||quant.ans
          when ans=13 then menustr.ans="tm;dist to msl;no criteria,distance"||symbol.ans||quant.ans
          when ans=14 then menustr.ans="fm;dist from msl;no criteria,distance"||symbol.ans||quant.ans
          otherwise nop
         end /*select*/
        end /*if*/
        else do
         symbol.ans="="
         quant.ans=0
         select
          when ans=10 then menustr.ans="p1;fuel ore;no criteria,quantity"||symbol.ans||quant.ans
          when ans=11 then menustr.ans="p2;organics;no criteria,quantity"||symbol.ans||quant.ans
          when ans=12 then menustr.ans="p3;equipment;no criteria,quantity"||symbol.ans||quant.ans
          when ans=13 then menustr.ans="tm;dist to msl;no criteria,distance"||symbol.ans||quant.ans
          when ans=14 then menustr.ans="fm;dist from msl;no criteria,distance"||symbol.ans||quant.ans
          otherwise nop
         end /*select*/
        end /*else*/
       end /*when*/
       otherwise nop
      end /*select*/
      if ans>0 then do
       rslt=""
       do i=1 to menustr.0
        select
         when menuval.i=1 then nop
         when i=1                  then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||menuval.i-1
         when i<=8                 then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||menuval.i-2
         when i=9 & menuval.i=4    then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||ptype
         when i=9                  then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||menuval.i-2
         when i<=14 & menuval.i\=1 then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||symbol.i||quant.i
         when i<=14                then rslt=rslt||";"||_dword(menustr.i,1,";")||":"||menuval.i-2
         otherwise nop
        end /*select*/
       end /*do*/
       rslt=substr(rslt,2)
      end /*if*/
    
     end /*do*/
    
    return rslt

/** _mapfind v.5 **/
    _mapfind: procedure expose (globals)
     start=arg(1)
     searchstring=arg(2)
     mapname=arg(3)
     reclen=arg(4)
     maxdist=arg(5)
     if maxdist="" | maxdist<1 then maxdist=255
    
     usevoids=0
     reverse=0
     void=-1
     busted=-1
     figs=-1
     expl=-1
     pvis=-1
     deadend=-1
     bubble=-1
     tomsl=-1; frmsl=-1
     ptype=-1
     pore=-1;  porg=-1;  pequ=-1
     ppore=-1; pporg=-1; ppequ=-1
     viewed=-1
     /* parse search string */
     do i=1 to _dwords(searchstring,";")
      criteria=_dword(searchstring,i,";")
      tag=_dword(criteria,1,":")
      val=_dword(criteria,2,":")
      select
       when tag="r"   then reverse=val
       when tag="uv"  then usevoids=val
       when tag="v"   then void=val
       when tag="f"   then figs=val
       when tag="e"   then expl=val
       when tag="pt"  then ptype=lower(val)
       when tag="p1"  then pore=val
       when tag="p2"  then porg=val
       when tag="p3"  then pequ=val
       when tag="pp1" then ppore=val
       when tag="pp2" then pporg=val
       when tag="pp3" then ppequ=val
       when tag="pv"  then pvis=val
       when tag="pb"  then busted=val
       when tag="d"   then deadend=val
       when tag="b"   then bubble=val
       when tag="tm"  then tomsl=val
       when tag="fm"  then frmsl=val
       when tag="vw"  then viewed=val
       otherwise nop
      end /*select*/
     end /*do*/
    
     call _mapseek mapname, reclen, start
     _dist.start.start=0
     _path.start.start=start
    
     /* initialize arrays */
     inqueue.=0
     queue.=""
     queue.1=start
     inqueue.start=1
     tail=1
     do i=1 to _dwords(_s.start,";")
      code=_dword(_s.start,i,";")
      warptype=code%20000
      sector=code//20000
      if ((warptype<2 & \reverse) | (warptype>0 & reverse)) & (usevoids\=1 | \_v.sector) then do
       tail=tail+1
       queue.tail=sector
       inqueue.sector=1
      end /*if*/
     end /*do*/
     head=2
    
     if _verbose then do
      call _newline _ansi("bt;fye")
      if reverse then call zocwrite "searching ("||searchstring||")"||"->"||start||"... "
      else call zocwrite "searching "||start||"->("||searchstring||")... "
     end /*if*/
     if _verbose then mon=_spinner(0,500)
    
     done=0
     found=0
     do while \done & tail>=head
    
      current=queue.head
      call _mapseek mapname, reclen, current
    
      do i=1 to _dwords(_s.current,";")
    
       if _verbose then mon=_spinner(mon,100)
       code=_dword(_s.current,i,";")
       warptype=code%20000
       adjacent=code//20000
    
       /* add to tail */
       if ((warptype<2 & \reverse) | (warptype>0 & reverse)) & (usevoids\=1 | \_v.adjacent) & \inqueue.adjacent then do
        tail=tail+1
        queue.tail=adjacent
        inqueue.adjacent=1
       end /*if*/
    
       /* assign shortest warp distance */
       if warptype>0 & \reverse then do
        tdist=_dist.start.current
        _dist.start.current=min(_dist.start.current,_dist.start.adjacent+1)
        if tdist>_dist.start.current then _path.start.current=_path.start.adjacent||";"||current
       end /*if*/
    
       if warptype<2 & reverse then do
        tdist=_dist.current.start
        _dist.current.start=min(_dist.current.start,_dist.adjacent.start+1)
        if tdist>_dist.current.start then _path.current.start=current||";"||_path.adjacent.start
       end /*if*/
    
      end /*do*/
    
      /* evaluate the criteria */
      found=1
    
      if found & void\=-1    & void=\_v.current      then found=0
      if found & figs\=-1    & figs=\_f.current      then found=0
      if found & expl\=-1    & expl=\_sv.current     then found=0
      if found & pvis\=-1    & pvis=\_pv.current     then found=0
      if found & busted\=-1  & ((busted=1 & _bust.current<=0) | (busted=0 & _bust.current>0)) then found=0
      if found & deadend\=-1 & deadend=\_od.current  then found=0
    
      if found & bubble\=-1 then do
       if bubble & _bg.current=0 then found=0
       if \bubble & _bg.current\=0 then found=0
      end /*if*/
    
      if found & viewed\=-1 then do
       select
        when left(viewed,2)="<=" & _vs.current>substr(viewed,3)  then found=0
        when left(viewed,2)="<=" then nop
        when left(viewed,2)=">=" & _vs.current<substr(viewed,3)  then found=0 
        when left(viewed,2)=">=" then nop
        when left(viewed,2)="\=" & _vs.current=substr(viewed,3)  then found=0 
        when left(viewed,2)="\=" then nop
        when left(viewed,2)="<>" & _vs.current=substr(viewed,3)  then found=0 
        when left(viewed,2)="<>" then nop
        when left(viewed,1)="<"  & _vs.current>=substr(viewed,2) then found=0 
        when left(viewed,1)=">"  & _vs.current<=substr(viewed,2) then found=0 
        when left(viewed,1)="="  & _vs.current\=substr(viewed,2) then found=0 
        otherwise nop
       end /*select*/
      end /*if*/
    
      if found & tomsl\=-1 then do
       select
        when left(tomsl,2)="<=" & _dtomsl.current>substr(tomsl,3)  then found=0
        when left(tomsl,2)="<=" then nop
        when left(tomsl,2)=">=" & _dtomsl.current<substr(tomsl,3)  then found=0 
        when left(tomsl,2)=">=" then nop
        when left(tomsl,2)="\=" & _dtomsl.current=substr(tomsl,3)  then found=0 
        when left(tomsl,2)="\=" then nop
        when left(tomsl,2)="<>" & _dtomsl.current=substr(tomsl,3)  then found=0 
        when left(tomsl,2)="<>" then nop
        when left(tomsl,1)="<"  & _dtomsl.current>=substr(tomsl,2) then found=0 
        when left(tomsl,1)=">"  & _dtomsl.current<=substr(tomsl,2) then found=0 
        when left(tomsl,1)="="  & _dtomsl.current\=substr(tomsl,2) then found=0 
        otherwise nop
       end /*select*/
      end /*if*/
    
      if found & frmsl\=-1 then do
       select
        when left(frmsl,2)="<=" & _dfrmsl.current>substr(frmsl,3)  then found=0
        when left(frmsl,2)="<=" then nop
        when left(frmsl,2)=">=" & _dfrmsl.current<substr(frmsl,3)  then found=0 
        when left(frmsl,2)=">=" then nop
        when left(frmsl,2)="\=" & _dfrmsl.current=substr(frmsl,3)  then found=0 
        when left(frmsl,2)="\=" then nop
        when left(frmsl,2)="<>" & _dfrmsl.current=substr(frmsl,3)  then found=0 
        when left(frmsl,2)="<>" then nop
        when left(frmsl,1)="<"  & _dfrmsl.current>=substr(frmsl,2) then found=0 
        when left(frmsl,1)=">"  & _dfrmsl.current<=substr(frmsl,2) then found=0 
        when left(frmsl,1)="="  & _dfrmsl.current\=substr(frmsl,2) then found=0 
        otherwise nop
       end /*select*/
      end /*if*/
    
      if found & (ptype\=-1 | pore\=-1 | porg\=-1 | pequ\=-1) then cptype=_dword(_p.current,1,";")
    
      if found & ptype\=-1 then do
       select
        when ptype=0 & cptype\="" then found=0
        when ptype=0 then nop
        when ptype=1 & cptype="" then found=0
        when ptype=1 then nop
        when \_portmatch(cptype,ptype) then found=0
        otherwise nop
       end /*select*/
      end /*if*/
    
      if found & pore\=-1 then do
       if cptype="" then found=0
       else do
        cpore=_dword(_dword(_p.current,2,";"),1,",")
        select
         when left(pore,2)="<=" & cpore>substr(pore,3)  then found=0
         when left(pore,2)="<=" then nop
         when left(pore,2)=">=" & cpore<substr(pore,3)  then found=0
         when left(pore,2)=">=" then nop
         when left(pore,2)="\=" & cpore=substr(pore,3)  then found=0 
         when left(pore,2)="\=" then nop
         when left(pore,2)="<>" & cpore=substr(pore,3)  then found=0 
         when left(pore,2)="<>" then nop
         when left(pore,1)="<"  & cpore>=substr(pore,2) then found=0 
         when left(pore,1)=">"  & cpore<=substr(pore,2) then found=0 
         when left(pore,1)="="  & cpore\=substr(pore,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      if found & porg\=-1 then do
       if cptype="" then found=0
       else do
        cporg=_dword(_dword(_p.current,3,";"),1,",")
        select
         when left(porg,2)="<=" & cporg>substr(porg,3)  then found=0
         when left(porg,2)="<=" then nop
         when left(porg,2)=">=" & cporg<substr(porg,3)  then found=0 
         when left(porg,2)=">=" then nop
         when left(porg,2)="\=" & cporg=substr(porg,3)  then found=0 
         when left(porg,2)="\=" then nop
         when left(porg,2)="<>" & cporg=substr(porg,3)  then found=0 
         when left(porg,2)="<>" then nop
         when left(porg,1)="<"  & cporg>=substr(porg,2) then found=0 
         when left(porg,1)=">"  & cporg<=substr(porg,2) then found=0 
         when left(porg,1)="="  & cporg\=substr(porg,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      if found & pequ\=-1 then do
       if cptype="" then found=0
       else do
        cpequ=_dword(_dword(_p.current,4,";"),1,",")
        select
         when left(pequ,2)="<=" & cpequ>substr(pequ,3)  then found=0
         when left(pequ,2)="<=" then nop
         when left(pequ,2)=">=" & cpequ<substr(pequ,3)  then found=0 
         when left(pequ,2)=">=" then nop
         when left(pequ,2)="\=" & cpequ=substr(pequ,3)  then found=0 
         when left(pequ,2)="\=" then nop
         when left(pequ,2)="<>" & cpequ=substr(pequ,3)  then found=0 
         when left(pequ,2)="<>" then nop
         when left(pequ,1)="<"  & cpequ>=substr(pequ,2) then found=0 
         when left(pequ,1)=">"  & cpequ<=substr(pequ,2) then found=0 
         when left(pequ,1)="="  & cpequ\=substr(pequ,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      if found & ppore\=-1 then do
       if cptype="" then found=0
       else do
        cppore=_dword(_dword(_p.current,2,";"),2,",")
        select
         when left(ppore,2)="<=" & cppore>substr(ppore,3)  then found=0
         when left(ppore,2)="<=" then nop
         when left(ppore,2)=">=" & cppore<substr(ppore,3)  then found=0
         when left(ppore,2)=">=" then nop
         when left(ppore,2)="\=" & cppore=substr(ppore,3)  then found=0 
         when left(ppore,2)="\=" then nop
         when left(ppore,2)="<>" & cppore=substr(ppore,3)  then found=0 
         when left(ppore,2)="<>" then nop
         when left(ppore,1)="<"  & cppore>=substr(ppore,2) then found=0 
         when left(ppore,1)=">"  & cppore<=substr(ppore,2) then found=0 
         when left(ppore,1)="="  & cppore\=substr(ppore,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      if found & pporg\=-1 then do
       if cptype="" then found=0
       else do
        cpporg=_dword(_dword(_p.current,3,";"),2,",")
        select
         when left(pporg,2)="<=" & cpporg>substr(pporg,3)  then found=0
         when left(pporg,2)="<=" then nop
         when left(pporg,2)=">=" & cpporg<substr(pporg,3)  then found=0 
         when left(pporg,2)=">=" then nop
         when left(pporg,2)="\=" & cpporg=substr(pporg,3)  then found=0 
         when left(pporg,2)="\=" then nop
         when left(pporg,2)="<>" & cpporg=substr(pporg,3)  then found=0 
         when left(pporg,2)="<>" then nop
         when left(pporg,1)="<"  & cpporg>=substr(pporg,2) then found=0 
         when left(pporg,1)=">"  & cpporg<=substr(pporg,2) then found=0 
         when left(pporg,1)="="  & cpporg\=substr(pporg,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      if found & ppequ\=-1 then do
       if cptype="" then found=0
       else do
        cppequ=_dword(_dword(_p.current,4,";"),2,",")
        select
         when left(ppequ,2)="<=" & cppequ>substr(ppequ,3)  then found=0
         when left(ppequ,2)="<=" then nop
         when left(ppequ,2)=">=" & cppequ<substr(ppequ,3)  then found=0 
         when left(ppequ,2)=">=" then nop
         when left(ppequ,2)="\=" & cppequ=substr(ppequ,3)  then found=0 
         when left(ppequ,2)="\=" then nop
         when left(ppequ,2)="<>" & cppequ=substr(ppequ,3)  then found=0 
         when left(ppequ,2)="<>" then nop
         when left(ppequ,1)="<"  & cppequ>=substr(ppequ,2) then found=0 
         when left(ppequ,1)=">"  & cppequ<=substr(ppequ,2) then found=0 
         when left(ppequ,1)="="  & cppequ\=substr(ppequ,2) then found=0 
         otherwise nop
        end /*select*/
       end /*else*/
      end /*if*/
    
      /* have we found the destination? */
      select
       when found then done=1
       when _dist.start.current>maxdist & \reverse then done=1
       when _dist.current.start>maxdist & reverse then done=1
       when head=tail then done=1
       otherwise head=head+1
      end /*select*/
    
     end /*do*/
    
     if _verbose then do
      mon=_spinner(-1,100)
      call zocwriteln
     end /*if*/
    
     if \found | head=tail then current=0
    
    return current

/** _pad v.1 **/
    _pad: procedure expose (globals)
     rslt=arg(1)
     if arg(2,"E") then w=arg(2); else return rslt
     if \arg(3,"E") then m="L"; else m=arg(3)
     select
      when m="L" then rslt=left(rslt,w)
      when m="R" then rslt=reverse(left(reverse(rslt),w))
      when m="C" then rslt=center(rslt,w)
      otherwise       rslt=left(rslt,w)
     end /*select*/
    return rslt

/** _dword v.2 **/
    _dword: procedure expose (globals)
     rslt=translate(word(translate(arg(1),arg(3)||" "," "||arg(3)),arg(2))," "||arg(3),arg(3)||" ")
    return rslt

/** _space v.1 **/
    _space: procedure expose (globals)
     str=strip(arg(1))
     if arg(2,"E") then n=arg(2); else n=1
     if arg(3,"E") then pad=arg(3); else pad=" "
     rslt=word(str,1)
     do i=2 to words(str)
      rslt=rslt||copies(pad,n)||word(str,i)
     end /*do*/
    return rslt

/** _dwords v.2 **/
    _dwords: procedure expose (globals)
     rslt=words(translate(arg(1),arg(2)||" "," "||arg(2)))
    return rslt

/** _instr v.3 **/
    _instr: procedure expose (globals)
     fnd=arg(1)
     str=arg(2)
     if lower(arg(3))\="cs" then do
      fnd=lower(fnd)
      str=lower(str)
     end /*if*/
     if arg(1,"E") & arg(2,"E") & pos(fnd,str)>0 then rslt=1
     else rslt=0
    return rslt

/** _getscriptpath v.1 **/
    _getscriptpath:
     parse value zocgetglobaloption("ScriptPath") with . '="' spath '"'
     spath=dosfname(spath)
     if right(spath,1)\="\" then spath=spath||"\"
     if \dosisdir(spath) then call _error "invalid path in _getscriptpath"
    return spath

/** _ini_getheadings v.5 **/
    _ini_getheadings: procedure expose (globals)
     if arg(1,"E") then fname=arg(1)
     else call _error "missing parameter in _ini_getheadings"
     if arg(2,"E") then delim=left(arg(2),1)
     else delim=";"
     list=""
     if _fileopenr(fname) then do
      do while \_fileeof(fname)
       line=strip(linein(fname))
       if left(line,1)="[" then do
        if list="" then list=strip(translate(line,"  ","[]"))
        else list=list||delim||strip(translate(line,"  ","[]"))
       end /*if*/
      end /*do*/
      call _fileclose fname
     end /*do*/
     if list="" then list="##EOF##"
    return list

/** _drequestlist v.3 **/
    _drequestlist: procedure expose (globals)
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     select
      when i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
      when i<0 then rslt="##CANCEL##"
      otherwise rslt=_dword(arg(2),i+1,arg(3))
     end /*select*/
    return rslt

/** _stripint v.4 **/
    _stripint: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789"," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if \datatype(rslt,"W") then rslt=""
    return rslt

/** _ini_read v.1 **/
    _ini_read: procedure expose (globals)
     /* argument check */
     do i=1 to 3
      if \arg(i,"E") | arg(i,"O") then call _error "missing arguments in _ini_read."
     end /*do*/
    
     /* name arguments */
     fname=arg(1)
     s=strip(arg(2))
     k=strip(arg(3))
    
     if _fileopenr(fname) then do
      done=0
      found=0
      insection=0
      do while \done & \_fileeof(fname)
       line=strip(linein(fname))
       select
        when left(line,1)=";" then nop
        when line="["||s||"]" then insection=1
        when insection & left(line,1)="[" then done=1
        when insection & left(line,length(k)+1)=k||"=" then do
         v=strip(substr(line,length(k)+2))
         done=1
         found=1
        end /*when*/
        otherwise nop
       end /*select*/
      end /*do*/
      call _fileclose fname 
      if \found then v="##EOF##"
     end /*if*/
     else v="##EOF##"
    
    return v

/** _stripnum v.3 **/
    _stripnum: procedure expose (globals)
     mask=_space(translate(arg(1)," ","-0123456789."," "),0)
     rslt=_space(translate(arg(1)," ",mask," "),0)
     if left(rslt,1)="-" then rslt="-"||_space(translate(rslt," ","-"),0)
     else rslt=_space(translate(rslt," ","-"),0)
     if _dwords(rslt,".")>2 then rslt=_dword(rslt,1,".")||"."||_space(translate(substr(rslt,pos(".",rslt)+1)," ","."),0)
     if \datatype(rslt,"N") then rslt=""
    return rslt

/** _asknum v.4 **/
    _asknum: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an number:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=strip(zocask(msg, default))
     do while _stripnum(rslt)\=rslt | rslt=""
      default=rslt||" [please enter a number or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=strip(zocask(msg, default))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _askstr v.1 **/
    _askstr: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="enter an string:"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=zocask(msg, default)
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _beep v.2 **/
    _beep: procedure expose (globals)
     select
      when arg(1,"O") then call zocwrite d2c(7)
      when _fileexists(arg(1)) then call zocplaysound arg(1)
      otherwise call zocwrite d2c(7)
     end /*select*/
    return

/** _fileopenr v.4 **/
    _fileopenr: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileopenr"
     if _fileexists(arg(1)) then do
      call stream arg(1), "C", "OPEN READ"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*if*/
     else rslt=0
    return rslt

/** _quit v.7 **/
    _quit: procedure expose (globals)
     lcpy=1
     arg1=""
     do i=1 to 2 /* manage arguments */
      select
       when arg(i,"E") & lower(arg(i))="nocopy" then lcpy=0
       when arg(i,"E") & arg1="" then arg1=arg(i)
       otherwise nop
      end /*select*/
     end /*do*/
     line=zocgetscreen(0, zocgetinfo("CURSOR-Y"), zocgetinfo("CURSOR-X"))
     select /* define message */
      when  lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m^M^J"||line
      when \lcpy & arg1="" then msg="^[[1;32m< end script >^[[0m "
      when  lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m^M^J"||line
      when \lcpy           then msg="^[[1;32m^M^J< end script: "||arg1||" >^[[0m "
      otherwise nop
     end /*select*/
     call zocwrite msg
     select /* choose a beep */
      when lower(arg1)="script cancelled by user." then call _beep "cancel.wav"
      otherwise call _beep "quit.wav"
     end /*select*/
     exit
    return 1

/** _fileeof v.4 **/
    _fileeof: procedure expose (globals)
     rslt=\lines(arg(1))
    return rslt

/** _spinner v.3 **/
    _spinner: procedure expose (globals)
     if arg(1,"E") then count=arg(1)
                   else call _error "missing parameter in _spinner"
     if arg(2,"E") then width=arg(2)
                   else width=100
     if arg(3,"E") & length(arg(3))=5 then chs=arg(3)
                                      else chs="-\|/."
    /* bs="^H" */
     bs=d2c(27)||"[1D"
     select
      when count=-1        then call zocwrite bs||substr(chs,5,1)
      when count<0         then count=-1
      when count=0         then call zocwrite left(chs,1)
      when count=width     then call zocwrite bs||substr(chs,2,1)
      when count=(width*2) then call zocwrite bs||substr(chs,3,1)
      when count=(width*3) then call zocwrite bs||substr(chs,4,1)
      when count=(width*4) then do
       call zocwrite bs||left(chs,1)
       count=0
      end /*when*/
      otherwise nop
     end /*select*/
     count=count+1
    return count

/** _fileclose v.3 **/
    _fileclose: procedure expose (globals)
     if \arg(1,"E") then call _error "missing argument in _fileclose"
     call stream arg(1), "C", "CLOSE"
    return

/** _sendwait v.1 **/
    _sendwait: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _sendwait"
     call zocsend arg(1)
     rslt=zocwait(arg(2))
     select
      when \arg(3,"E") | arg(3)=""             then nop
      when lower(arg(3))="timeout"  & rslt=640 then call _error "timeout"
      when lower(arg(3))="lastline" & rslt=640 then call _error "timeout"
      when lower(arg(3))="lastline"            then rslt=_lastline()
      otherwise nop
     end /*select*/
    return rslt

/** _filenew v.4 **/
    _filenew: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _filenew"
     if arg(2,"E") & lower(arg(2))="delete" then call dosdel arg(1)
     if _fileexists(arg(1)) then rslt=0
     else do
      call stream arg(1), "C", "OPEN WRITE"
      rslt=_fileready(arg(1))
      if \rslt then call _fileclose arg(1)
     end /*else*/
    return rslt

/** _lastline v.3 **/
    _lastline: procedure expose (globals)
     rslt=zoclastline()
     select
      when lower(arg(1))="raw" then nop
      when pos(d2c(7),rslt)>0  then rslt=translate(zocstring("REMOVE", rslt, d2c(7)),"  ",d2c(0)||d2c(10))
      otherwise                     rslt=translate(rslt,"  ",d2c(0)||d2c(10))
     end /*select*/
    return rslt

/** _calc_base_date v.3 **/
    /* v.3 tested */
    _calc_base_date: procedure expose (globals)
    
     yr=arg(1); mm=arg(2); dd=arg(3); hr=arg(4); mn=arg(5); sc=arg(6)
    
     /* leapyear? */
        leapyear=abs((yr//4=0)-1)
    
     /* day of year */
        doy=dd-1
        do i=1 to mm-1
         doy=doy+_dword(_monthdays,i,";")
        end /*do*/
        if mm>2 & leapyear then doy=doy+1
    
     /* base day since 2000 */
        base=_baseday.yr-_baseday.2000+doy
    
     /* seconds of day */
        sod=((hr*60)+mn)*60+sc
    
     /* base day in seconds */
        base_sec=base*86400+sod
    
     rslt=base||";"||doy||";"||sod||";"||base_sec
    
    return rslt

/** _portmatch v.1 **/
    _portmatch: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") then call _error "missing parameter in _portmatch"
     m1=lower(strip(arg(1)))
     m2=lower(strip(arg(2)))
     rslt=0
     select
      when length(m1)\=3 then nop
      when length(m2)\=3 then nop
      when m1=m2 then rslt=1
      otherwise do
       mm1=0
       if left(m1,1)="x" then mm1=1
       if left(m2,1)="x" then mm1=1
       if left(m1,1)=left(m2,1) then mm1=1
       mm2=0
       if substr(m1,2,1)="x" then mm2=1
       if substr(m2,2,1)="x" then mm2=1
       if substr(m1,2,1)=substr(m2,2,1) then mm2=1
       mm3=0
       if substr(m1,3,1)="x" then mm3=1
       if substr(m2,3,1)="x" then mm3=1
       if substr(m1,3,1)=substr(m2,3,1) then mm3=1
       if mm1 & mm2 & mm3 then rslt=1
      end /*otherwise*/
     end /*select*/
    return rslt

/** _drequestlisti v.2 **/
    _drequestlisti: procedure expose (globals)
     do i=1 to 3
      if \arg(i,"E") then call _error "missing parameter in _drequestlisti"
     end /*do*/
     i=zocrequestlist(arg(1),translate(arg(2),"|"||arg(3),arg(3)||"|"))
     if i<0 & lower(arg(4))="c" then call _quit "script cancelled by user.", "nocopy"
                                else rslt=i+1
    return rslt

/** _askporttype v.5 **/
    _askporttype: procedure expose (globals)
     do i=1 to 3
      select
       when i=1 & arg(i,"E") then msg=arg(i)
       when i=1              then msg="what type of port?"
       when i=2 & arg(i,"E") then default=arg(i)
       when i=2              then default=""
       when i=3 & arg(i,"E") then cflag=min(verify(lower(arg(i)),"c","M"),1)
       when i=3              then cflag=0
       otherwise nop
      end /*select*/
     end /*do*/
     rslt=upper(strip(zocask(msg, default)))
     do while \(verify(rslt,"XBS")=0 & length(rslt)=3)
      default=rslt||" [please enter a valid port string or ESC to cancel.]"
      if rslt="##CANCEL##" then leave
      else rslt=upper(strip(zocask(msg, default)))
     end /*do*/
     if cflag & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    return rslt

/** _chooselist v.6 **/
    _chooselist: procedure expose (globals)
     prompt=arg(1)
     list=arg(2)
     if list="" then call _error "no list"
     delim=arg(3)
     if delim="" then delim=" "
     if length(delim)>1 then call _error "long delimiter"
    
     ch.=""
     i=_dwords(list,delim)
     do j=1 to i
      ch.j=_dword(list,j,delim)
     end /*do*/
    
     if i<7 then max=1
     if i<5 then max=0
     if i>=7 then max=(i-5)%2+1
    
     done=0
     loc=0
     do while \done
      if loc<0 then loc=0
      if loc>max then loc=max
    
      select
       when loc=0 then do
        if max=0 then rslt=zocrequest(prompt, ch.1, ch.2, ch.3, ch.4)
        else rslt=zocrequest(prompt, ch.1, ch.2, ch.3, "next")
       end /*when*/
       when loc=max then do
        p1=(loc-1)*2+4
        p2=p1+1
        p3=p1+2
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, ch.p3)
       end /*when*/
       otherwise do
        p1=(loc-1)*2+4
        p2=p1+1
        rslt=zocrequest(prompt, "back", ch.p1, ch.p2, "next")
       end /*otherwise*/
      end /*select*/
    
      select
       when rslt="next" then loc=loc+1
       when rslt="back" then loc=loc-1
       when rslt="##CANCEL##" then done=1
       when rslt="" then nop
       otherwise done=1
      end /*select*/
    
     end /*do*/
    
     if lower(arg(4))="c" & rslt="##CANCEL##" then call _quit "script cancelled by user.", "nocopy"
    
    return rslt

/** _mapseek v.3 **/
    _mapseek: procedure expose (globals)
     if \arg(1,"E") | \arg(2,"E") | \arg(3,"E") then call _error "missing parameter in _mapseek"
     fname=arg(1)
     reclen=arg(2)
     sector=arg(3)
    
     if _s.sector="_S."||sector | _s.sector="" then do
    
      call stream fname, "C", "SEEK "||(sector-1)*reclen+2
     
      vis=0
      one=0
      prt=0
      pvis=0
      bore=0
      borg=0
      bequ=0
      flags=c2d(charin(fname))
      if flags%128=1 then do
       bequ=1
       flags=flags-128
      end /*if*/
      if flags%64=1 then do
       borg=1
       flags=flags-64
      end /*if*/
      if flags%32=1 then do
       bore=1
       flags=flags-32
      end /*if*/
      if flags%16=1 then do
       _pv.sector=1
       flags=flags-16
      end /*if*/
      if flags%8=1 then do
       prt=1
       flags=flags-8
      end /*if*/
      if flags%4=1 then flags=flags-4
      if flags%2=1 then do
       _od.sector=1
       flags=flags-2
      end /*if*/
      if flags%1=1 then do
       _sv.sector=1
       flags=flags-1
      end /*if*/
     
      if prt then do
       if bore then _p.sector="B"
       else _p.sector="S"
       if borg then _p.sector=_p.sector||"B"
       else _p.sector=_p.sector||"S"
       if bequ then _p.sector=_p.sector||"B"
       else _p.sector=_p.sector||"S"
       do i=1 to 3
        ms1=charin(fname)
        ms2=charin(fname)
        ms3=charin(fname)
        _p.sector=_p.sector||";"c2d(ms1)+c2d(ms2)*256||","||c2d(ms3)
       end /*do*/
      end /*if*/
      else do
       _p.sector=""
       call stream fname, "C", "SEEK "||1+(sector-1)*reclen+11
      end /*else*/
      _dtomsl.sector=c2d(charin(fname))
      _dfrmsl.sector=c2d(charin(fname))
      _bg.sector=c2d(charin(fname))+c2d(charin(fname))*256
      _nwi.sector=c2d(charin(fname))
    
      ms1=c2d(charin(fname))+c2d(charin(fname))*256
      if ms1=0 then _s.sector=""
      else do
       _s.sector=ms1
       do i=1 to ((reclen-15)%2-1)
        ms1=c2d(charin(fname))+c2d(charin(fname))*256
        if ms1>0 then _s.sector=_s.sector||";"||ms1
       end /*do*/
      end /*else*/
    
     end /*if*/
    return

/** _fileready v.1 **/
    _fileready: procedure expose (globals)
     if \arg(1,"E") then call _error "missing parameter in _fileready"
     if stream(arg(1), "S")\="NOTREADY" then rslt=1; else rslt=0
    return rslt